perm filename DDGO.SAI[GO,ALS] blob
sn#105684 filedate 1974-06-12 generic text, type T, neo UTF8
00100 BEGIN "GOMAIN"
00200
00300
00400 INTEGER SIMPLEMODE,DPYYET,RUNBEFORE;
00500 REQUIRE "GOEVAL" LOAD_MODULE;
00600 REQUIRE "GOLOOK" LOAD_MODULE;
00700 REQUIRE "GOFAIL" LOAD_MODULE;
00800 REQUIRE "GOMOVE" LOAD_MODULE;
00900
01000 STRING INSTR,GAMBUF,GARBAGE,STRNG1,INSTRG,STRNG;
01100
01200 INTERNAL STRING FSSTRG;
01300
01400 DEFINE CRLF="('15&'12)",LF="'12",TT="1",CHRSCN="2",
01500 FF="('15&'12&'14)",TAB="'11",CRLF2="(CRLF&CRLF)",
01600 CRLF3="(CRLF2&CRLF)",
01700 BLI="(IF I>8 THEN '101+I ELSE '100+I)",
01800 DSKI="3",DSKO="4",DSKTAB="3",LSTO="5",
01900 BLACK="'200000",WHITE="'400000",BLANK="'100000",NONOCC="'40000";
02000
02100 INTEGER NXTMOV,J,K,II,IJ,BRCHAR,ENDFIL,PLAYSELF,STKSET,LGTH,WCHDAT,
02200 FFLAG,L,STOPMV,SCORE,HDCP,ARWLGO,BITWRD,HALFWD,GB0123;
02300
02400 EXTERNAL INTEGER SENTE,ISEN,JSEN,LVL,I,SE,SF,PLAYER,ISAV,JSAV,
02500 KKK,LEXIST,CURI,CURJ;
02600
02700 PRELOAD_WITH 88,94,100,214,220,226,340,346,352,1000;
02800 SAFE INTERNAL INTEGER ARRAY HDCPNT[0:9],MSGDPY[0:49],BRDDPY[0:99],
02900 PNTDPY[0:499];
03000
03100 SAFE EXTERNAL INTEGER ARRAY XGB3,XGB1,XGBOAR[0:440],XSTKSR[-2:99],
03200 ADJWGT,BLSAVE,WHSAVE,DIFWGT,FRDWGT,ENMWGT,BLDATA,WHDATA[0:35],
03300 XSTRPT[0:255],XGRPPT[-3:149],ARMIES,WALLS[-3:99],MSCVAL[0:35],
03400 MSCWGT,KLLWGT,LIVWGT[0:35],SCRFRV,SCRENV[0:16],XAREAP[0:50],
03500 XGB2[0:442],LBONUS[0:17];
03600
03700 INTERNAL INTEGER MOVENO,TTYGUY,KOTAC,OUTPON,GAMVAL,BOARDS,IIIDPY,MOVETIME;
03800
03900 INTERNAL INTEGER NDXFOR,PFORCE,IFORCE,JFORCE,IFOR,JFOR,KFOR;
04000
04100 PRELOAD_WITH "INFLUENCE","BASE SCORE","DELT SCORE","ARMIES","WALLS",
04200 "GROUPS","STRINGS","AREA","POINT","OCTLS";
04300 SAFE STRING ARRAY DPTITL[1:10];
04400
04500 EXTERNAL INTEGER PROCEDURE GBFGET(INTEGER INDEX);
04600 EXTERNAL INTEGER PROCEDURE GBEGET(INTEGER INDEX);
04700 EXTERNAL INTEGER PROCEDURE INFLPT(INTEGER INDEX);
04800 EXTERNAL PROCEDURE GBFPUT(INTEGER VALU,NDX);
04900 EXTERNAL PROCEDURE GBEPUT(INTEGER VALU,NDX);
05000 EXTERNAL PROCEDURE CONSET;
05100 EXTERNAL PROCEDURE SCRUPD;
05200 EXTERNAL INTEGER PROCEDURE IIISET;
05300 EXTERNAL INTEGER PROCEDURE STRATEVAL(INTEGER I,PLAYER,ISRT,ISTP);
05400 EXTERNAL PROCEDURE LADDERSET(INTEGER STRNGNO);
05500 EXTERNAL PROCEDURE REDOST(INTEGER I,J);
05600
05700 REQUIRE "DPYSUB" LOAD_MODULE;
05800 REQUIRE "DDDPY" LOAD_MODULE;
05900 EXTERNAL PROCEDURE DPYSET(INTEGER ARRAY DPYBUF);
06000 EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
06100 EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
06200 EXTERNAL PROCEDURE APOINT(INTEGER X,Y);
06300 EXTERNAL PROCEDURE DPYBIG(INTEGER SIZE);
06400 EXTERNAL PROCEDURE DPYSST(STRING STR);
06500 EXTERNAL PROCEDURE DPYOUT(INTEGER POG);
06600 EXTERNAL PROCEDURE DPYTYP(INTEGER POSITION,GLITCHES,PER_GLITCH);
06700 EXTERNAL PROCEDURE DDOUT(INTEGER ARRAY DDBUF);
06800 EXTERNAL PROCEDURE DDCLR;
06900 EXTERNAL PROCEDURE SWAPIT;
07000
07100 PROCEDURE ALINE(INTEGER I,J,K,L); BEGIN
07200 AIVECT(I,J); AVECT(K,L) END;
07300 PROCEDURE DPYSVS(INTEGER X,Y;STRING S); BEGIN
07400 AIVECT(X,Y); DPYSST(S); END;
07500
07600
07700 EXTERNAL PROCEDURE PUTBWB(INTEGER POS,PIECE);
07800 EXTERNAL INTEGER ARRAY DDBUF[1:5200];
07900
08000
08100 STRING PROCEDURE TTYSTRING; BEGIN
08200 STRING ANSWER;
08300 ANSWER←INPUT(TT,TT);
08400 IF DPYYET THEN DPYTYP(-410,3,1);
08500 RETURN(ANSWER) END;
08600
08700
08800
08900 INTERNAL PROCEDURE HEDOUT(INTEGER DVCE);
09000 BEGIN COMMENT
09100 **********WRITE A GENERAL-PURPOSE HEADER*****;
09200 INTEGER YEAR,MONTH,DAY;
09300 OUT(DVCE,GAMBUF[1 TO 20]); OUT(DVCE,TAB&TAB&"MOVE");
09400 SETFORMAT(4,7); OUT(DVCE,CVS(MOVENO)); OUT(DVCE,TAB);
09500 YEAR←CALL(0,"DATE"); DAY←(YEAR MOD 31)+1; MONTH←YEAR DIV 31;
09600 YEAR←(MONTH DIV 12)+64; MONTH←(MONTH MOD 12)+1;
09700 OUT(DVCE,CVS(MONTH)); OUT(DVCE,CVS(DAY)); OUT(DVCE,CVS(YEAR));
09800 OUT(DVCE,TAB); OUT(DVCE,CVS(CALL(0,"RUNTIM")));
09900 SETFORMAT(0,7);
10000 END;
10100
10200
10300 INTERNAL STRING PROCEDURE BLIJ(INTEGER I,J);
10400 BEGIN COMMENT SET UP 5-CHARACTER STRING OF COORDINATES;
10500 INTEGER IWRD;
10600 IWRD←((('40 LSH 7)+'40) LSH 7)+BLI;
10700 IWRD←(IWRD LSH 14)+(('40 LSH 7)+'60);
10800 IWRD←J+(IF J<10 THEN IWRD ELSE (IWRD LSH 7)+'246);
10900 RETURN(CVSTR(IWRD LSH 1));
11000 END;
11100
11200
11300 PROCEDURE MBW;
11400 BEGIN COMMENT PROMPT TTY FOR ANOTHER MOVE INPUT;
11500 SETFORMAT(6,7); OUT(TT,CVS(MOVENO)); SETFORMAT(0,7);
11600 IF MOVENO LAND 1 THEN OUT(TT,TAB&"B: ") ELSE OUT(TT,TAB&"W* ");
11700 END;
11800
11900
12000
12100
12200
12300 INTEGER PROCEDURE COORDGET;
12400 BEGIN COMMENT
12500
12600 **********
12700 RETURN THE DECIMAL VALUE OF A MOVE COORDINATE WHETHER
12800 IT IS A LETTER, A ONE-DIGIT NUMBER, OR A TWO-DIGIT
12900 NUMBER.
13000 **********;
13100
13200 BRCHAR←" ";
13300 WHILE BRCHAR=" " DO K←SCAN(INSTRG,CHRSCN,BRCHAR);
13400
13500 IF "0"≤BRCHAR≤"9" THEN BEGIN
13600 J←BRCHAR-"0";
13700 K←SCAN(INSTRG,CHRSCN,BRCHAR);
13800 IF "0"≤BRCHAR≤"9" THEN RETURN(10*J+BRCHAR-"0")
13900 ELSE BEGIN INSTRG←BRCHAR&INSTRG; RETURN(J); END;
14000 END;
14100 RETURN(IF "J"≤BRCHAR≤"T" THEN BRCHAR-"A"
14200 ELSE IF"A"≤BRCHAR≤"I" THEN BRCHAR-'100 ELSE 0);
14300 END; COMMENT COORDGET;
14400
14500
14600
14700
14800
14900 PROCEDURE OPENDISK(INTEGER CHANL,MODE;STRING FILNAM);
15000 BEGIN COMMENT
15100
15200 **********OPEN DISK OUTPUT FILE**********;
15300
15400 OPEN(CHANL,"DSK",MODE,0,2,0,BRCHAR,ENDFIL);
15500 ENTER(CHANL,FILNAM,FFLAG);
15600 IF FFLAG THEN OUT(TT,"NO ROOM ON DISK"&CRLF);
15700 END;
15800
15900
16000
16100
16200
16300 INTEGER PROCEDURE ODSKOPN(INTEGER CHANL;STRING FILNAM);
16400 BEGIN COMMENT
16500
16600 **********CHECK DISK FOR PRESENCE OF A FILE**********;
16700
16800 OPEN(CHANL,"DSK",0,2,0,200,BRCHAR,ENDFIL);
16900 LOOKUP(CHANL,FILNAM,FFLAG);
17000 CLOSE(CHANL); RELEASE(CHANL);
17100 IF FFLAG THEN BEGIN
17200 OPENDISK(CHANL,0,FILNAM); RETURN(1);
17300 END ELSE RETURN(0);
17400 END;
17500
17600
17700
17800
17900
18000 EXTERNAL PROCEDURE AWUPDA;
18100 EXTERNAL PROCEDURE AREA;
18200 EXTERNAL PROCEDURE UNMOVE;
18300 EXTERNAL INTEGER PROCEDURE LEGAL(INTEGER I,J,MVNO);
18400 EXTERNAL PROCEDURE UPDAT;
18500 EXTERNAL PROCEDURE EVAL;
18600
18700
18800
18900
19000
19100 PROCEDURE HOLDVALS;
19200 BEGIN COMMENT
19300 **********SAVE A BUNCH OF COEFFICIENTS**********;
19400 OPENDISK(DSKO,8,GAMBUF[1 TO 6]&".COF");
19500 ARRYOUT(DSKO,ADJWGT[0],36);
19600 ARRYOUT(DSKO,DIFWGT[0],36);
19700 ARRYOUT(DSKO,ENMWGT[0],36);
19800 ARRYOUT(DSKO,FRDWGT[0],36);
19900 ARRYOUT(DSKO,KLLWGT[0],36);
20000 ARRYOUT(DSKO,LIVWGT[0],36);
20100 ARRYOUT(DSKO,MSCVAL[0],36);
20200 ARRYOUT(DSKO,MSCWGT[0],36);
20300 ARRYOUT(DSKO,XGB2[0],441);
20400 ARRYOUT(DSKO,LBONUS[0],18);
20500 CLOSE(DSKO); RELEASE(DSKO);
20600 END;
20700
20800
20900
21000
21100
21200 PROCEDURE RESTVALS;
21300 BEGIN COMMENT
21400 **********UNDO HOLDVALS**********;
21500 ARWLGO←2;
21600 OUT(TT,"COEFF FILE (<CR> TO SAVE PRESENT COEFFICIENTS):");
21700 STRNG←TTYSTRING;
21800 IF LENGTH(STRNG)=0 THEN BEGIN SCRUPD; RETURN END;
21900 OPEN(DSKI,"DSK",8,2,0,200,BRCHAR,ENDFIL);
22000 LOOKUP(DSKI,STRNG&".COF",FFLAG);
22100 IF FFLAG THEN OUT(TT,"CAN'T FIND FILE"&CRLF)
22200 ELSE BEGIN
22300 ARRYIN(DSKI,ADJWGT[0],36);
22400 ARRYIN(DSKI,DIFWGT[0],36);
22500 ARRYIN(DSKI,ENMWGT[0],36);
22600 ARRYIN(DSKI,FRDWGT[0],36);
22700 ARRYIN(DSKI,KLLWGT[0],36);
22800 ARRYIN(DSKI,LIVWGT[0],36);
22900 ARRYIN(DSKI,MSCVAL[0],36);
23000 ARRYIN(DSKI,MSCWGT[0],36);
23100 ARRYIN(DSKI,XGB2[0],441);
23200 ARRYIN(DSKI,LBONUS[0],18);
23300 SCRUPD;
23400 END;
23500 CLOSE(DSKI); RELEASE(DSKI)
23600 END;
23700
23800
23900
24000
24100
24200 BOOLEAN PROCEDURE SETSIDES;
24300 BEGIN COMMENT DEFINE WHICH SIDE IS WHICH FOR PLAYING OR DISPLAYING;
24400 LABEL PIKSID;
24500 PIKSID:OUT(TT,"PICK SIDE, B OR W:"); STRNG←TTYSTRING;
24600 K←SCAN(STRNG,CHRSCN,BRCHAR); PLAYSELF←0;
24700 IF BRCHAR="B" THEN TTYGUY←1
24800 ELSE IF BRCHAR="W" THEN TTYGUY←0
24900 ELSE IF BRCHAR="X" THEN BEGIN
25000 PLAYSELF←1; TTYGUY←(MOVENO+1) LAND 1;
25100 OUT(TT,"UNTIL MOVE:"); STOPMV←CVD(TTYSTRING);
25200 IF MOVENO≥STOPMV THEN RETURN(FALSE);
25300 END ELSE GO TO PIKSID;
25400 RETURN(TRUE);
25500 END;
00100 STRING PROCEDURE VALFLN;
00200 RETURN(CVS(K)&" DELT="&CVS(GBFGET(SCRFRV[K]))&" "&
00300 BLIJ(SCRFRV[K] DIV 21,SCRFRV[K] MOD 21));
00400 STRING PROCEDURE VALELN;
00500 RETURN(CVS(K)&" BASE="&CVS(GBEGET(SCRENV[K]))&" "&
00600 BLIJ(SCRENV[K] DIV 21,SCRENV[K] MOD 21));
00700
00800 INTERNAL PROCEDURE VALOUT(INTEGER NBR);
00900 IF OUTPON THEN BEGIN COMMENT
01000 *****WRITE A HARD COPY OF THE VALUED MOVES*****;
01100 IF NBR=15 THEN BEGIN
01200 OUT(LSTO,CRLF3); OUT(LSTO,(IF TTYGUY THEN "W " ELSE "B "));
01300 HEDOUT(LSTO); OUT(LSTO,CRLF3);
01400 END;
01500 SETFORMAT(6,7);
01600 FOR K←1 STEP 1 UNTIL NBR DO
01700 OUT(LSTO,VALELN&(TAB&TAB)&VALFLN&CRLF);
01800 OUT(LSTO,CRLF&"GAMVAL"&CVS(GAMVAL)&CRLF2);
01900 SETFORMAT(0,7);
02000 END;
02100
02200 PROCEDURE DPYVAL;
02300 OUT(TT,"******** DPYVAL NOT IMPLEMENTED FOR DATA DISK DISPLAY ********");
02400
02500 STRING PROCEDURE BRDLIN(STRING HCP,BNK,BLK,WHT,NOC);
02600 BEGIN COMMENT
02700 **********SET UP BOARD LINE OUTPUT STRING**********;
02800 INTEGER XXX;
02900 K←21*I+20; STRNG←NULL;
03000 FOR J←K-20 STEP 1 UNTIL K DO BEGIN
03100 XXX←CASE GB0123 OF (XGBOAR[J],XGB1[J],XGB2[J],XGB3[J]);
03200 STRNG←STRNG&(IF ((XXX≠-1)∧(XXX LAND BITWRD)) THEN "↑" ELSE " ");
03300 IF XGB1[J] LAND NONOCC THEN STRNG←STRNG&NOC
03400 ELSE IF XGB1[J] LAND BLANK THEN BEGIN
03500 WHILE J>HDCPNT[L] DO L←L+1;
03600 STRNG←STRNG&(IF J=HDCPNT[L] THEN HCP ELSE BNK);
03700 END ELSE STRNG←STRNG&(IF XGB1[J] LAND BLACK THEN BLK ELSE WHT);
03800 END;
03900 RETURN(STRNG);
04000 END;
04100
04200 INTERNAL PROCEDURE BRDOUT;
04300 IF OUTPON THEN BEGIN COMMENT
04400 **********HARD COPY OF BOARD*****;
04500 L←0;
04600 OUT(LSTO,FF); HEDOUT(LSTO); OUT(LSTO,CRLF3);
04700 FOR I←0 STEP 1 UNTIL 20 DO
04800 OUT(LSTO,BRDLIN("# ","+ ","B ","W "," ")&CRLF);
04900 OUT(LSTO,CRLF2);
05000 END;
05100
05200 PROCEDURE DPYBRD;BEGIN
05300 INTEGER TEMP;
05400 DPYYET←IIIDPY←1;
05500 DDCLR;
05600 DPYTYP(-410,3,1);
05700 COMMENT
05800 **********DISPLAY BOARD POSITION ON SCOPE**********;
05900 DPYSET(PNTDPY);
06000 DPYBIG(3);
06100 FOR I←1 STEP 1 UNTIL 19 DO BEGIN
06200 STRNG←BLI;
06300 J←485-40.5*I;
06400 K←40*I-(IF I>9 THEN 635 ELSE 627);
06500 DPYSVS(-627,J,STRNG); DPYSVS(173,J,STRNG);
06600 DPYSVS(K,485,STRNG←CVS(I)); DPYSVS(K,-325,STRNG);
06700 END;
06800 DPYOUT(2);
06900 FOR I←0 STEP 1 UNTIL 419 DO
07000 IF ¬((TEMP←XGB1[I]) LAND NONOCC) THEN BEGIN
07100 TEMP←IF TEMP LAND BLACK THEN "B" ELSE
07200 IF TEMP LAND WHITE THEN "W" ELSE " ";
07300 PUTBWB(I,TEMP);END;
07400 DDOUT(DDBUF);
07500 END;
07600
07700 PROCEDURE HAFOUT;
07800 OUT(TT,"******** HAFOUT NOT IMPLEMENTED FOR DATA DISK DISPLAY ********");
07900
08000 PROCEDURE BTSOUT;
08100 OUT(TT,"******** BTSOUT NOT IMPLEMENTED FOR DATA DISK DISPLAY ********");
08200
08300 PROCEDURE DPYDAT;
08400 OUT(TT,"******** DPYDAT NOT IMPLEMENTED FOR DATA DISK DISPLAY ********");
00100 PROCEDURE SETOUTPUT;
00200 BEGIN COMMENT
00300
00400 **********SET UP AUTOMATIC TRACING OUTPUT**********;
00500 OUT(TT,"SET OUTPUT: "); INSTRG←TTYSTRING;
00600 IF (OUTPON←OUTPON LAND 1) THEN BEGIN
00700 LABEL OUTPLP;
00800 OUTPLP: K←SCAN(INSTRG,CHRSCN,BRCHAR);
00900 IF BRCHAR="E" THEN BEGIN OUTPON←OUTPON LOR '1000; DPYBRD; END;
01000 IF BRCHAR="D" THEN OUTPON←OUTPON LOR '4000;
01100 IF BRCHAR="B" THEN OUTPON←OUTPON LOR '10000;
01200 IF BRCHAR="V" THEN OUTPON←OUTPON LOR '20000;
01300 IF BRCHAR="F" THEN OUTPON←OUTPON LOR '40000;
01400 IF BRCHAR THEN GO TO OUTPLP;
01500 END ELSE OUT(TT,"NO DSK FILE");
01600 END; COMMENT SETOUTPUT;
01700
01800
01900
02000
02100
02200 PROCEDURE DOOUTPUT;
02300 IF ¬SIMPLEMODE ∧ OUTPON LAND '1000 THEN
02400 OUT(TT,TAB&TAB&"S="&CVS(GAMVAL)&TAB&"T="&CVS(MOVETIME)&
02500 TAB&"B="&CVS(BOARDS)&CRLF);
02600
02700
02800
02900
03000
03100 BOOLEAN PROCEDURE LGLMOV(INTEGER I,J,ADDMOVE);
03200 BEGIN COMMENT
03300
03400 **********
03500 LGLMOV ENTERS MOVES INTO THE GAME RECORD AND MANAGES THE
03600 MOVE TRACE. IF AN ILLEGAL MOVE IS ATTEMPTED, IT IS NOT
03700 RECORDED AND LGLMOV GIVES A DIAGNOSTIC.
03800 **********;
03900
04000 CASE LEGAL(I,J,MOVENO) OF BEGIN
04100 BEGIN
04200 IF ADDMOVE THEN BEGIN
04300 IF LENGTH(GAMBUF)<NXTMOV THEN GAMBUF←GAMBUF&I&J
04400 ELSE GAMBUF←GAMBUF[1 TO NXTMOV-1]&I&J&
04500 GAMBUF[NXTMOV+2 TO ∞];
04600 END;
04700 NXTMOV←NXTMOV+2; MOVENO←MOVENO+1;
04800 REDOST(I,J); COMMENT FIND STRINGS AFFECTED;
04900 IF STKSET∨(XSTKSR[-1]>(-10 LSH 18)) THEN XSTKSR[-1]←XSTKSR[-2];
05000 IF OUTPON>1 THEN DOOUTPUT; RETURN(TRUE);
05100 END; COMMENT MOVE WAS LEGAL;
05200 OUT(TT,"BAD COORDS:");
05300 OUT(TT,"KO ERROR:");
05400 OUT(TT,"POINT OCCUPIED:");
05500 OUT(TT,"SUICIDE:");
05600 OUT(TT,"A-W-S OVERFLOW");
05700 END; COMMENT MOVE CASES;
05800 OUT(TT,BLIJ(I,J)); OUT(TT,CRLF); RETURN(FALSE);
05900 END; COMMENT LGLMOV;
06000
06100
06200
06300
06400
06500 COMMENT THIS IS USED TO SET PARMS BY Q COMMAND;
06600 PROCEDURE VARSETS(REFERENCE INTEGER ARRAY X;STRING S;INTEGER NDX);
06700 FOR I←CVD(INSTR) STEP 1 UNTIL NDX DO BEGIN
06800 OUT(TT,CVS(X[I])&TAB&S&"["&CVS(I)&"]: ");
06900 STRNG←TTYSTRING;
07000 IF BRCHAR='175 THEN RETURN;
07100 IF LENGTH(STRNG)>0 THEN X[I]←CVD(STRNG);
07200 END;
07300
07400
07500
07600
07700
07800 PROCEDURE H2;
07900 BEGIN
08000 I←LEGAL(16,4,1)+LEGAL(4,16,1);
08100 IF LENGTH(GAMBUF)=20 THEN GAMBUF←GAMBUF&(HDCP+50)&(HDCP+50);
08200 NXTMOV←NXTMOV+2; MOVENO←MOVENO+1; XSTKSR[-1]←XSTKSR[-2];
08300 END;
08400 PROCEDURE H4;
08500 BEGIN I←LEGAL(4,4,1)+LEGAL(16,16,1); H2; END;
08600 PROCEDURE H6;
08700 BEGIN I←LEGAL(10,4,1)+LEGAL(10,16,1); H4; END;
08800 PROCEDURE H8;
08900 BEGIN I←LEGAL(4,10,1)+LEGAL(16,10,1); H6; END;
09000
09100
09200 PROCEDURE UPDO(INTEGER UPDA);
09300 BEGIN COMMENT
09400 **********
09500 CARRY OUT THE INITIAL UPDATING PROCESS ACCORDING TO DIRECTION
09600 FROM EITHER UPSTRT OR THE "C" (CONTINUE) COMMAND.
09700 **********;
09800 CASE HDCP OF BEGIN
09900 ; ; H2;
10000 BEGIN I←LEGAL(16,16,1); H2; END;
10100 H4;
10200 BEGIN I←LEGAL(10,10,1); H4; END;
10300 H6;
10400 BEGIN I←LEGAL(10,10,1); H6; END;
10500 H8;
10600 BEGIN I←LEGAL(10,10,1); H8; END;
10700 END; COMMENT END OF HDCP SETUP CASE;
10800 IF UPDA THEN UPDAT ELSE ARWLGO←0;
10900 HDCP←0;
11000 END;
11100
11200
11300
11400
11500
11600 BOOLEAN PROCEDURE UPSTRT;
11700 BEGIN COMMENT
11800 **********
11900 THE ROUTINE CAN BE USED TO SET HANDICAP STONES AND TO GIVE
12000 INITIAL GOODNESS VALUES TO EACH BOARD POINT. IT WILL START A
12100 A GAME FOR THE PLAYING PROGRAM AT ANY POSITION.
12200 **********;
12300 IF (ARWLGO≥0)∧¬SETSIDES THEN RETURN(FALSE);
12400 IF ¬SIMPLEMODE THEN SETOUTPUT;
12500 IF ARWLGO=2 THEN RETURN(TRUE);
12600 IF MOVENO=1 THEN BEGIN
12700 OUT(TT,"Handicap: "); HDCP←CVD(TTYSTRING);
12800 IF HDCP<0 THEN HDCP←0; IF HDCP>9 THEN HDCP←9;
12900 IF PLAYSELF∧(HDCP>1) THEN TTYGUY←1-TTYGUY;
13000 END;
13100 UPDO(ARWLGO=1); IF (OUTPON>1)∧(ARWLGO=1) THEN DOOUTPUT;
13200 RETURN(TRUE);
13300 END;
13400
13500
13600
13700
13800
13900 PROCEDURE GETMOVES;
14000 BEGIN COMMENT
14100 **********
14200 THIS IS THE SCANNER FOR MOVE COORDINATES INPUT FROM THE TTY.
14300 IT SHOULD BE ABLE TO HANDLE ANY REASONABLE COMBINATION OF LETTERS
14400 AND NUMBERS. WE EXPECT EITHER 1-19 OR A-H,J-T TO SPECIFY A
14500 POSITION ALONG AN AXIS. WE DON'T CARE WHERE THE ORIGIN IS (AS
14600 LONG AS IT DOESN'T CHANGE!)
14700 **********;
14800 LABEL GETMORE,LOP1; INTEGER IVAL,JVAL;
14900 GETMORE:MBW;
15000 INSTRG←TTYSTRING; IF BRCHAR='175 THEN RETURN; ARWLGO←0;
15100 LOP1:IVAL←COORDGET; JVAL←COORDGET;
15200 IF JVAL=0 THEN GO TO GETMORE;
15300 IF LGLMOV(IVAL,JVAL,1) THEN BEGIN DDOUT(DDBUF);GO TO LOP1 END;
15400 END;
00100 PROCEDURE MAINPROG(STRING COMDSTR);
00200 BEGIN COMMENT
00300
00400 **********
00500 THIS IS THE MAIN PROGRAM FOR DIRECTING ALMOST EVERYTHING. IT CAN
00600 BE CALLED BY EVALTRACE IN GOEVAL DURING LOOKAHEAD. IT CAN ALSO
00700 BE USED AT ANY TIME BETWEEN MOVES AND AS AN EDITOR FOR TYPING
00800 IN OR LOOKING AT GAMES
00900 **********;
01000
01100 LABEL ECOMMANDS,NXTEDIT,EC1,CASEST;
01200 GO TO NXTEDIT;
01300 EC1:OUT(TT,CRLF);
01400 ECOMMANDS:
01500 OUT(TT,"*"); COMDSTR←TTYSTRING;
01600 NXTEDIT:K←SCAN(COMDSTR,CHRSCN,BRCHAR);
01700 IF BRCHAR=0 THEN GO TO EC1;
01800 IF "A"≤BRCHAR≤"Z" THEN
01900 CASEST:CASE BRCHAR-"A" OF BEGIN
02000
02100
02200
02300
02400 BEGIN COMMENT A;
02500 COMMENT ****** AUTOMATIC MODE *******;
02600 INTEGER NEWGAME;LABEL REVERT,RESUME;
02700 SIMPLEMODE←TRUE;
02800 IF LENGTH(GAMBUF)>0 THEN BEGIN
02900 OUT(TT,"Type ""C"" to continue this game,"
03000 &" or anything else to start over: ");
03100 INSTR←TTYSTRING;
03200 IF BRCHAR='175 THEN GO REVERT;
03300 IF INSTR="C" THEN GO RESUME END;
03400 OUT(TT,"Do you wish to start a NEW game or resume an OLD game?"
03500 &" (Type N or O): ");
03600 WHILE TRUE DO BEGIN
03700 INSTR←TTYSTRING;
03800 IF INSTR="N" THEN BEGIN NEWGAME←1; DONE END
03900 ELSE IF INSTR="O" THEN BEGIN NEWGAME←0; DONE END
04000 ELSE IF BRCHAR='175 COMMENT <ALTMODE>; THEN GO REVERT
04100 ELSE OUT(TT,"Please type N or O: ");
04200 END;
04300 IF NEWGAME THEN OUT(TT,"Please type a name for this game: ")
04400 ELSE OUT(TT,"Please type the name you gave that game: ");
04500 GAMBUF←TTYSTRING;
04600 IF BRCHAR='175 THEN GO REVERT;
04700 GAMBUF←GAMBUF&" ";
04800 GAMBUF←GAMBUF[1 FOR 20];
04900 SCRUPD;
05000 IF NEWGAME THEN BEGIN MAINPROG("EX"); DPYBRD END
05100 ELSE MAINPROG("EGCX");
05200 RESUME: COMDSTR←"O"&COMDSTR;
05300 GO TO NXTEDIT;
05400 REVERT: SIMPLEMODE←FALSE;
05500 OUT(TT,CRLF);
05600 COMDSTR←"N"&COMDSTR;
05700 END; COMMENT A;
05800
05900
06000 BRDOUT; COMMENT WRITE BOARD ON LSTO;
06100
06200
06300 BEGIN COMMENT C
06400 **********CONTINUE GAME TO MOVE XXX**********;
06500 STRING MOVELIST;
06600 IF ¬SIMPLEMODE THEN BEGIN
06700 OUT(TT,"THROUGH:"); STOPMV←CVD(TTYSTRING)*2+19 END
06800 ELSE STOPMV←1000000;
06900 FFLAG←0; OUTPON↔FFLAG; STKSET←1; ARWLGO←0;
07000 IF STOPMV<NXTMOV THEN STOPMV←NXTMOV;
07100 IF LENGTH(GAMBUF)<STOPMV THEN BEGIN
07200 STOPMV←LENGTH(GAMBUF)-1;
07300 IF STOPMV<NXTMOV THEN GO TO ECOMMANDS;
07400 END;
07500 MOVELIST←GAMBUF[NXTMOV TO STOPMV+1];
07600 IF (NXTMOV=21)∧(GAMBUF[21 FOR 1]>50) THEN BEGIN
07700 HDCP←LOP(MOVELIST)-50; I←LOP(MOVELIST); UPDO(0);
07800 END;
07900 WHILE LENGTH(MOVELIST)>0 DO
08000 LGLMOV(LOP(MOVELIST),LOP(MOVELIST),0);
08100 OUTPON←FFLAG; DPYBRD;
08200 END; COMMENT CONTINUE;
08300
08400
08500 BEGIN COMMENT D
08600 **********DISPLAY HEADING INFORMATION**********;
08700 HEDOUT(TT); OUT(TT,CRLF);
08800 END;
08900
09000
09100 BEGIN COMMENT E
09200 **********ERASE (INITIALIZE) INTERNAL REPRESENTATION**********;
09300
09400 CONSET; COMMENT DEFINE INFLUENCE TABLE;
09500 FOR I←0 STEP 1 UNTIL 440 DO XGBOAR[I]←0;
09600 FOR I←21 STEP 21 UNTIL 399 DO BEGIN
09700 XGB1[I]←XGB1[I+20]←NONOCC+'177;
09800 FOR J←I+1 STEP 1 UNTIL I+19 DO XGB1[J]←BLANK;
09900 END;
10000 FOR I←0 STEP 1 UNTIL 20 DO XGB1[I]←XGB1[I+420]←NONOCC+'177;
10100 XSTRPT[126]←0;
10200 FOR K←0 STEP 1 UNTIL 125 DO XSTRPT[K]←K+1;
10300 XSTKSR[-1]←XSTKSR[-2]; IIIDPY←ARWLGO←0;
10400 MOVENO←1; NXTMOV←21;
10500 ARMIES[-3]←MSCVAL[1]; WALLS[-3]←MSCVAL[2];
10600 XGRPPT[-3]←MSCVAL[10];
10700 ARMIES[-1]←-(ARMIES[-2]←MSCVAL[3] LSH 18)+1;
10800 WALLS[-1]←-(WALLS[-2]←MSCVAL[4] LSH 18)+1;
10900 END; COMMENT EDITING START;
11000
11100
11200
11300
11400
11500 BEGIN COMMENT F
11600 **********FINISH AND FILE GAME**********;
11700
11800 IF OUTPON≠0 THEN BEGIN
11900 OUTPON←0; CLOSE(LSTO); RELEASE(LSTO);
12000 END;
12100 IF ODSKOPN(DSKO,GAMBUF[1 TO 6]&".GAM")=0 THEN BEGIN
12200 OUT(TT,"FILE OVERWRITE?");
12300 IF TTYSTRING≠"Y" THEN GO TO ECOMMANDS;
12400 OPENDISK(DSKO,0,GAMBUF[1 TO 6]&".GAM");
12500 END;
12600 OUT(DSKO,GAMBUF[1 TO ∞]);
12700 CLOSE(DSKO); RELEASE(DSKO); RETURN;
12800 END; COMMENT FINISH FILE;
12900
13000
13100
13200
13300
13400 BEGIN COMMENT G
13500 **********GET GAME FILE FROM DISK**********;
13600 OPEN(DSKI,"DSK",0,2,0,200,BRCHAR,ENDFIL);
13700 LOOKUP(DSKI,GAMBUF[1 TO 6]&".GAM",FFLAG);
13800 IF ¬FFLAG THEN BEGIN
13900 ENDFIL←0; GAMBUF←NULL;
14000 WHILE ¬ENDFIL DO GAMBUF←GAMBUF&INPUT(DSKI,DSKTAB);
14100 END ELSE OUT(TT,"CAN'T FIND FILE"&CRLF);
14200 CLOSE(DSKI); RELEASE(DSKI);
14300 END; COMMENT GAME GET;
14400
14500
14600
14700
14800
14900 IF OUTPON THEN BEGIN COMMENT H
15000 **********WRITE OUT COEFFICIENTS**********;
15100 OUT(LSTO,FF); HEDOUT(LSTO); OUT(LSTO,CRLF2); SETFORMAT(8,7);
15200 OUT(LSTO," MSCVAL DIFWGT ENMWGT FRDWGT ADJWGT MSCWGT"
15300 &" KLLWGT LIVWGT LBONUS"&CRLF2);
15400 FOR I←0 STEP 1 UNTIL 35 DO BEGIN
15500 IF (I MOD 10)=0 THEN OUT(LSTO,CRLF);
15600 OUT(LSTO,CVS(MSCVAL[I])&CVS(DIFWGT[I])&CVS(ENMWGT[I])
15700 &CVS(FRDWGT[I])&CVS(ADJWGT[I])&
15800 CVS(MSCWGT[I])&CVS(KLLWGT[I])&CVS(LIVWGT[I]));
15900 IF I≤17 THEN OUT(LSTO,CVS(LBONUS[I])&CRLF) ELSE OUT(LSTO,CRLF);
16000 END;
16100 SETFORMAT(0,7); OUT(LSTO,FF);
16200 END;
16300
16400
16500 ;COMMENT I;
16600 ;COMMENT J;
16700 ;COMMENT K;
16800
16900 BEGIN COMMENT L
17000 **********SET UP LIFE-AND-DEATH OF ONE OR ALL STRINGS**********;
17100 SETOUTPUT;
17200 OUT(TT,"STRING:"); LADDERSET(CVD(TTYSTRING));
17300 END;
17400
17500
17600 BEGIN COMMENT M
17700 **********MOVE INPUT FROM TTY**********;
17800 ARWLGO←-1; IF ¬UPSTRT THEN GO TO NXTEDIT; STKSET←0; GETMOVES;
17900 END;
18000
18100
18200
18300
18400
18500 BEGIN COMMENT N
18600 **********NAME THE CURRENT GAME BUFFER
18700 1ST 6 CHRS ARE GAME FILE NAME**********;
18800
18900 IF OUTPON THEN GO TO NXTEDIT;
19000 OUT(TT,"20-CHR NAME:"); STRNG←TTYSTRING;
19100 IF LENGTH(STRNG)>0 THEN BEGIN
19200 WHILE LENGTH(STRNG)<20 DO STRNG←STRNG&" ";
19300 IF LENGTH(GAMBUF)≤20 THEN GAMBUF←STRNG[1 TO 20]
19400 ELSE GAMBUF←STRNG[1 TO 20]&GAMBUF[21 TO ∞];
19500 END;
19600 IF ¬ODSKOPN(LSTO,GAMBUF[1 TO 6]&".LGO") THEN BEGIN
19700 OUT(TT,"DEL OLD LST FILE?");
19800 IF TTYSTRING="Y" THEN OPENDISK(LSTO,0,GAMBUF[1 TO 6]&".LGO")
19900 ELSE OPENDISK(LSTO,0,GAMBUF[1 TO 6]&".TMP");
20000 END;
20100 OUTPON←1; RESTVALS;
20200 END; COMMENT NAMER;
20300
20400
20500
20600
20700
20800 BEGIN "O" COMMENT
20900 **********OPPONENT SITTING AT TTY**********;
21000
21100 LABEL PDPMOV,TTYMOV; INTEGER TEMP;
21200 IF ARWLGO≠2 THEN ARWLGO←0;
21300 IF ¬UPSTRT THEN GO TO NXTEDIT; STKSET←0; ARWLGO←2;
21400 DDOUT(DDBUF);
21500 IF (MOVENO LAND 1)=TTYGUY THEN BEGIN OUT(TT,TAB&TAB&TAB);GO TO TTYMOV END;
21600
21700 PDPMOV:EVAL;
21800 IF GBFGET(SCRFRV[1])<MSCVAL[9] THEN BEGIN
21900 OUT(TT,"*** GAME OVER ***"); GO TO ECOMMANDS;
22000 END;
22100 MBW; OUT(TT,BLIJ(I←SCRFRV[1] DIV 21,J←SCRFRV[1] MOD 21));
22200 IF PLAYSELF THEN TTYGUY←1-TTYGUY;
22300 IF LGLMOV(I,J,1)=0 THEN GO TO ECOMMANDS;
22400 IF (OUTPON LAND '1000)=0 THEN OUT(TT,TAB);
22500 DDOUT(DDBUF);
22600 IF SIMPLEMODE THEN BEGIN
22700 OPENDISK(DSKO,0,GAMBUF[1 TO 6]&".GAM");
22800 OUT(DSKO,GAMBUF[1 TO ∞]);
22900 CLOSE(DSKO); RELEASE(DSKO) END;
23000 IF PLAYSELF THEN IF MOVENO≥STOPMV THEN GO TO ECOMMANDS ELSE GO TO PDPMOV;
23100 TTYMOV:MBW;
23200 INSTRG←TTYSTRING;
23300 IF BRCHAR='175 THEN BEGIN SIMPLEMODE←FALSE; GO TO NXTEDIT END;
23400 COMMENT <ALTMODE>,<U>,<U> WILL UNDO THE LAST EXCHANGE;
23500 XSTKSR[-1]←XSTKSR[-2];
23600 I←COORDGET; J←COORDGET;
23700 TEMP←LGLMOV(I,J,1);
23800 DDOUT(DDBUF);
23900 IF TEMP THEN GO TO PDPMOV ELSE GO TO TTYMOV;
24000 END; COMMENT OPPONENTS;
24100
24200
24300 ;COMMENT P;
24400
24500
24600 BEGIN COMMENT Q
24700 **********QUESTION THE DATE BASE**********;
24800 LABEL QLOP,QLOP1;
24900 QLOP:OUT(TT,"++"); INSTR←TTYSTRING;
25000 IF LENGTH(INSTR)=0 ∨ BRCHAR='175 THEN GO TO NXTEDIT;
25100 QLOP1:K←SCAN(INSTR,CHRSCN,BRCHAR);
25200 IF BRCHAR=0 THEN GO TO QLOP;
25300 IF "A"≤BRCHAR≤"Z" THEN
25400 CASE BRCHAR-"A" OF BEGIN
25500
25600
25700 ;COMMENT A;
25800 BEGIN COMMENT BOARD POSITION;
25900 LABEL GBLOP;
26000 OUT(TT,"BITWRD"); STRNG←TTYSTRING;
26100 IF LENGTH(STRNG)>0 THEN BEGIN
26200 BITWRD←CVO(STRNG);
26300 GBLOP: OUT(TT,"GB0123"); STRNG←TTYSTRING;
26400 IF LENGTH(STRNG)>0 THEN GB0123←CVO(STRNG);
26500 IF (GB0123>3)∨(GB0123<0) THEN GO TO GBLOP;
26600 END;
26700 DPYBRD;
26800 END;
26900 HAFOUT; COMMENT CALCULATIONS;
27000 VARSETS(DIFWGT,"DIFWGT",35);
27100 VARSETS(ENMWGT,"ENMWGT",35);
27200 VARSETS(FRDWGT,"FRDWGT",35);
27300 ;COMMENT G;
27400 HOLDVALS; COMMENT HOLD COEFFICIENT AND GB2 VALUES;
27500 DPYDAT; COMMENT INFORMATION;
27600 VARSETS(ADJWGT,"ADJWGT",35);
27700 VARSETS(KLLWGT,"KLLWGT",35);
27800 VARSETS(LIVWGT,"LIVWGT",35);
27900 VARSETS(MSCVAL,"MSCVAL",35);
28000 VARSETS(MSCWGT,"MSCWGT",35);
28100 VARSETS(LBONUS,"LBONUS",17);
28200 BTSOUT; COMMENT PIECES OF XGB1;
28300 ;COMMENT Q;
28400 RESTVALS; COMMENT RESTORE COEFFICIENT AND GB2 VALUES;
28500 ;COMMENT S;
28600 ;COMMENT T;
28700 ;COMMENT U;
28800 DPYVAL; COMMENT VALUED MOVES LIST;
28900 ;COMMENT W;
29000 ;COMMENT X;
29100 ;COMMENT Y;
29200 ;COMMENT Z;
29300
29400
29500 END; COMMENT END OF CASE;
29600 IIIDPY←0; COMMENT DISABLE BOARD CONTINUATION;
29700 GO TO QLOP1;
29800 END; COMMENT Q;
29900
30000
30100
30200
30300
30400 IF OUTPON THEN BEGIN COMMENT R
30500 **********GAME RECORD**********;
30600 INTEGER NSTRT;
30700 NSTRT←1; OUT(LSTO,FF&"GAME RECORD: ");
30800 HEDOUT(LSTO); OUT(LSTO,CRLF3);
30900 FOR IJ←21 STEP 20 UNTIL NXTMOV-2 DO BEGIN
31000 OUT(LSTO,"MOVE "); OUT(LSTO,CVS((NSTRT LSH -1)+1));
31100 OUT(LSTO,":"&TAB); NSTRT←NSTRT+20;
31200 L←IF NXTMOV≤IJ+18 THEN NXTMOV-2 ELSE IJ+18;
31300 IF (IJ=21)∧((K←GAMBUF[21 FOR 1]-50)>0) THEN BEGIN
31400 OUT(LSTO,CVS(K)); OUT(LSTO," HDCP"&TAB); K←23;
31500 END ELSE K←IJ;
31600 FOR K←K STEP 2 UNTIL L DO BEGIN
31700 OUT(LSTO,BLIJ(GAMBUF[K FOR 1],GAMBUF[K+1 FOR 1]));
31800 OUT(LSTO,TAB);
31900 END;
32000 OUT(LSTO,CRLF2);
32100 END;
32200 END;
32300
32400
32500
32600
32700
32800 BEGIN COMMENT S
32900 **********SET UP PREDICTED MOVE SCORES*****;
33000 ARWLGO←1; IF ¬UPSTRT THEN GO TO NXTEDIT; ARWLGO←0;
33100 END;
33200
33300
33400 ;COMMENT T;
33500
33600
33700 IF ¬STKSET ∧ (XSTKSR[-1]>XSTKSR[-2]) THEN BEGIN COMMENT
33800 **********UNMOVE THE LAST MOVE*****;
33900 UNMOVE; ARWLGO←0; IF OUTPON>1 THEN DOOUTPUT;
34000 NXTMOV←NXTMOV-2; MOVENO←MOVENO-1;
34100 REDOST(GAMBUF[NXTMOV FOR 1],GAMBUF[NXTMOV+1 FOR 1]);
34200 IF LENGTH(GAMBUF)=NXTMOV+1 THEN GAMBUF←GAMBUF[1 TO NXTMOV-1];
34300 END ELSE OUT(TT,"CAN'T");
34400
34500
34600 VALOUT(15); COMMENT HARD COPY OF VALUED MOVES;
34700
34800
34900 ;COMMENT W;
35000 RETURN;COMMENT X;
35100 ;COMMENT Y;
35200 ;COMMENT Z;
35300
35400
35500
35600
35700
35800 END; COMMENT FINISH OF THE CASE STATEMENT;
35900 GO TO NXTEDIT;
36000 END; COMMENT END OF CALLABLE MAIN PROGRAM;
36100
36200
36300
36400 SWAPIT;
36500 GARBAGE←0;
36600 FOR I←1 STEP 1 UNTIL '52 DO
36700 IF (I≠'12) ∧ (I≠'40) THEN GARBAGE←GARBAGE&I;
36800 FOR I←'72 STEP 1 UNTIL '100,'133 STEP 1 UNTIL '174,'176,'177 DO
36900 GARBAGE←GARBAGE&I;
37000
37100 FSSTRG←NULL; SETFORMAT(2,7);
37200 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
37300 FOR J←1 STEP 1 UNTIL 9 DO FSSTRG←FSSTRG&CVS(J);
37400 FSSTRG←FSSTRG&" 0";
37500 END; SETFORMAT(0,7);
37600
37700 BREAKSET(TT,'12&'175,"I"); BREAKSET(TT,GARBAGE,"O");
37800 BREAKSET(CHRSCN,NULL,"X"); BREAKSET(DSKTAB,NULL,"I");
37900
38000 OPEN(TT,"TTY",1,2,2,100,BRCHAR,ENDFIL);
38100 DPYYET←OUTPON←0;
38200
38300 SCRENV[0]←SCRFRV[0]←441; SCRENV[16]←SCRFRV[16]←442;
38400
38500 IF ¬RUNBEFORE THEN BEGIN RESTVALS; RUNBEFORE←TRUE END
38600 ELSE BEGIN
38700 OUT(TT,"This program is initialized in Automatic Mode.
38800 To revert to the more complicated but more general mode described
38900 in Jon Ryder's thesis, type <altmode>. Send complaints to MAL...
39000
39100
39200 ");
39300
39400 MAINPROG("A");
39500 END;
39600
39700
39800
39900 END "GOMAIN"